home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / prog_pas / sk210f.zip / TESTLIST.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-10  |  10KB  |  363 lines
  1. {$I SHDEFINE.INC}
  2.  
  3. {$I SHUNITSW.INC}
  4.  
  5. unit TestList;
  6. {
  7.                         To test the ShList unit
  8.  
  9.                   Copyright 1991 Madison & Associates
  10.                           All Rights Reserved
  11.  
  12.          This program source file and the associated executable
  13.          file may be  used and distributed  only in  accordance
  14.          with the  provisions  described  on  the title page of
  15.                   the accompanying documentation file
  16.                               SKYHAWK.DOC
  17. }
  18.  
  19. interface
  20.  
  21. uses
  22.   TpCrt,
  23.   TpDos,
  24.   ShList;
  25.  
  26. procedure ListTest;
  27.  
  28. implementation
  29.  
  30. type
  31.   Str6  = string[6];
  32.  
  33. {$F+}
  34. function Less(var DRec1, DRec2) : boolean;
  35.   begin
  36.     Less := (Str6(DRec1) <= Str6(DRec2));
  37.     end; {Less}
  38. {$F-}
  39.  
  40. procedure ListTest;
  41.  
  42. const
  43.   NumLines = 7;
  44.   Dat   : array[1..NumLines] of Str6 = (
  45.                                         'abcd-1',
  46.                                         'bcda-2',
  47.                                         'dcba-3',
  48.                                         'adcb-4',
  49.                                         'cdab-5',
  50.                                         'badc-6',
  51.                                         'dabc-7'
  52.                                        );
  53.  
  54. var
  55.   sL1,           {Load by PUSHing}
  56.   sL2,           {Load by APPENDing}
  57.   sL3  : slList; {Load by INSERTing the first element, PUSHing the second,
  58.                  and INSERTing the remainder.}
  59.  
  60.   dL0,           {Load by INSERTing the first two elements and
  61.                  INSERTPREVing the remainder.}
  62.   dL1,           {Load by PUSHing}
  63.   dL2,           {Load by APPENDing}
  64.   dL3,           {Load by INSERTing the first element, PUSHing the second,
  65.                  and INSERTing the remainder.}
  66.   dL4  : dlList; {Load by PutSorted}
  67.  
  68.   OT  : text;
  69.   S1  : Str6;
  70.   T1,
  71.   T2  : byte;
  72.  
  73. procedure slBombOut;
  74.   begin
  75.     WriteLn(OT, ' slBomb out');
  76.     halt;
  77.     end;
  78.  
  79. procedure dlBombOut;
  80.   begin
  81.     WriteLn(OT, ' dlBomb out');
  82.     end;
  83.  
  84. procedure AnyKey;
  85.   begin
  86.     if HandleIsConsole(1) then begin
  87.       Write('Any key to continue...');
  88.       if ReadKey = #0 then ;
  89.       WriteLn;
  90.       end;
  91.     end;
  92.  
  93. begin
  94.   if not OpenStdDev(OT, 1) then begin
  95.     WriteLn('Can''t open console device.');
  96.     Halt(1);
  97.     end;
  98.  
  99.   if HandleIsConsole(1) then begin
  100.     WriteLn(OT,'This program produces extensive output, which you may wish');
  101.     WriteLn(OT,'to study in detail. For this reason, console output can be');
  102.     WriteLn(OT,'redirected to a file or to the printer. If you wish to'    );
  103.     WriteLn(OT,'use this option, <Ctrl><Break> out at the following pause,');
  104.     WriteLn(OT,'and re-invoke the program with the desired redirection.'   );
  105.     WriteLn(OT);
  106.     AnyKey;
  107.     end;
  108.  
  109.   WriteLn(OT);
  110.   WriteLn(OT,'BEGINNING THE slList TEST SUITE');
  111.   T1 := 0;
  112.   WriteLn(OT,MemAvail);WriteLn(OT);
  113.   slListInit(sL1, SizeOf(S1));
  114.   slListInit(sL2, SizeOf(S1));
  115.   slListInit(sL3, SizeOf(S1));
  116.  
  117.   for T1 := 1 to NumLines do begin
  118.  
  119.     S1 := Dat[T1];
  120.     if not slPush(sL1, S1) then slBombOut;
  121.     WriteLn(OT,'sL1 ',S1:6, slCount(sL1):4, slSpaceUsed(sL1):5);
  122.     if not slAppend(sL2, S1) then slBombOut;
  123.     WriteLn(OT,'sL2 ',S1:6, slCount(sL2):4, slSpaceUsed(sL2):5);
  124.  
  125.     if T1 = 2 then begin
  126.       if not slPush(sL3, S1) then slBombOut
  127.       end
  128.     else begin
  129.       if not slPut(sL3, S1) then slBombOut
  130.       end;
  131.     WriteLn(OT,'sL3 ',S1:6, slCount(sL3):4, slSpaceUsed(sL3):5);
  132.  
  133.     WriteLn(OT,'Data string ',T1,' loaded.'); WriteLn(OT);
  134.     Flush(OT);
  135.     end; {for T1}
  136.  
  137.   WriteLn(OT);
  138.   WriteLn(OT,'GetFirst check, using sL1');
  139.   S1 := '';
  140.   if not slGetFirst(sL1, S1) then slBombOut;
  141.   WriteLn(OT,S1:8);
  142.  
  143.   WriteLn(OT);
  144.   WriteLn(OT,'GetLast check, using sL1');
  145.   S1 := '';
  146.   if not slGetLast(sL1, S1) then slBombOut;
  147.   WriteLn(OT,S1:8);
  148.  
  149.   WriteLn(OT);
  150.   WriteLn(OT,'Tail Check on sL1, sL2, sL3.');
  151.   WriteLn(OT,'sL1, ',(sL1.Tail^.Next = nil),
  152.         '     sL2, ',(sL2.Tail^.Next = nil),
  153.         '     sL3, ',(sL3.Tail^.Next = nil));
  154.   AnyKey;
  155.   WriteLn(OT);
  156.  
  157.   WriteLn(OT,'GetNext check, using sL1. [7..1]');
  158.   WriteLn(OT,slGetFirst(sL1, S1):6, S1:7);
  159.   for T2 := 2 to 2*sL1.Count do begin
  160.     WriteLn(OT,slGetNext(sL1, S1):6, S1:7);
  161.     end;
  162.   AnyKey;
  163.  
  164.   WriteLn(OT);
  165.   WriteLn(OT,'GetNext check, using sL2. [1..7]');
  166.   WriteLn(OT,slGetFirst(sL2, S1):6, S1:7);
  167.   for T2 := 2 to 2*sL2.Count do begin
  168.     WriteLn(OT,slGetNext(sL2, S1):6, S1:7);
  169.     end;
  170.   AnyKey;
  171.  
  172.   WriteLn(OT);
  173.   WriteLn(OT,'GetNext check, using sL3. [2..7, 1]');
  174.   WriteLn(OT,slGetFirst(sL3, S1):6, S1:7);
  175.   for T2 := 2 to 2*sL3.Count do begin
  176.     WriteLn(OT,slGetNext(sL3, S1):6, S1:7);
  177.     end;
  178.   AnyKey;
  179.  
  180.   WriteLn(OT);
  181.   WriteLn(OT,'Tail Check on sL1, sL2, sL3.');
  182.   WriteLn(OT,'sL1, ',(sL1.Tail^.Next = nil),
  183.      '     sL2, ',(sL2.Tail^.Next = nil),
  184.      '     sL3, ',(sL3.Tail^.Next = nil));
  185.   AnyKey;
  186.  
  187.   WriteLn(OT);
  188.   WriteLn(OT,'Pop test, using sL1. [7..1]');
  189.   while slPop(sL1, S1) do
  190.     WriteLn(OT,S1);
  191.   WriteLn(OT,'sL1 ', slCount(sL1):3, slSpaceUsed(sL1):3);
  192.   AnyKey;
  193.  
  194.   WriteLn(OT);
  195.   WriteLn(OT,'Free test, using sL2, sL3.');
  196.   slFree(sL2); slFree(sL3);
  197.   WriteLn(OT,'sL2 ', slCount(sL2):3, slSpaceUsed(sL2):3);
  198.   WriteLn(OT,'sL3 ', slCount(sL3):3, slSpaceUsed(sL3):3);
  199.   WriteLn(OT,MemAvail);
  200.   slFree(sL1);
  201.   AnyKey;
  202.  
  203.   WriteLn(OT);
  204.   WriteLn(OT,'BEGINNING THE dlList TEST SUITE');
  205.   WriteLn(OT,MemAvail); WriteLn(OT);
  206.   dlListInit(dL0, SizeOf(S1));
  207.   dlListInit(dL1, SizeOf(S1));
  208.   dlListInit(dL2, SizeOf(S1));
  209.   dlListInit(dL3, SizeOf(S1));
  210.   dlListInit(dL4, SizeOf(S1));
  211.  
  212.   for T1 := 1 to NumLines do begin
  213.     S1 := Dat[T1];
  214.     if T1 < 3 then begin
  215.       if not dlPut(dL0, S1) then dlBombOut;
  216.       end
  217.     else begin
  218.       if not dlPutPrev(dL0, S1) then dlBombOut;
  219.       end;
  220.  
  221.     WriteLn(OT,'dL0 ',S1:6, dlCount(dL0):4, dlSpaceUsed(dL0):5);
  222.     if not dlPush(dL1, S1) then dlBombOut;
  223.     WriteLn(OT,'dL1 ',S1:6, dlCount(dL1):4, dlSpaceUsed(dL1):5);
  224.     if not dlAppend(dL2, S1) then dlBombOut;
  225.     WriteLn(OT,'dL2 ',S1:6, dlCount(dL2):4, dlSpaceUsed(dL2):5);
  226.     if T1 = 2 then begin
  227.       if not dlPush(dL3, S1) then dlBombOut
  228.       end
  229.     else begin
  230.       if not dlPut(dL3, S1) then dlBombOut
  231.       end;
  232.     WriteLn(OT,'dL3 ',S1:6, dlCount(dL3):4, dlSpaceUsed(dL3):5);
  233.     if not dlPutSorted(dL4, S1, Less) then dlBombOut;
  234.     WriteLn(OT,'dL4 ',S1:6, dlCount(dL4):4, dlSpaceUsed(dL4):5);
  235.     WriteLn(OT,'Data string ',T1,' loaded.'); WriteLn(OT);
  236.     Flush(OT);
  237.     end; {for T1}
  238.  
  239.   WriteLn(OT);
  240.   WriteLn(OT,'GetFirst check, using dL1.');
  241.   S1 := '';
  242.   if not dlGetFirst(dL1, S1) then dlBombOut;
  243.   WriteLn(OT,S1:8);
  244.  
  245.   WriteLn(OT);
  246.   WriteLn(OT,'GetLast check, using dL1.');
  247.   S1 := '';
  248.   if not dlGetLast(dL1, S1) then dlBombOut;
  249.   WriteLn(OT,S1:8);
  250.  
  251.   WriteLn(OT);
  252.   WriteLn(OT,'Tail Check on dL1, dL2, dL3.');
  253.   WriteLn(OT,'dL1, ',(dL1.Tail^.Next = nil),
  254.         '     dL2, ',(dL2.Tail^.Next = nil),
  255.         '     dL3, ',(dL3.Tail^.Next = nil));
  256.   AnyKey;
  257.  
  258.   WriteLn(OT);
  259.   WriteLn(OT,'GetNext check, using dL0. [1, 7..2]');
  260.   WriteLn(OT,dlGetFirst(dL0, S1):6, S1:7);
  261.   for T2 := 2 to 2*dL0.Count do begin
  262.     WriteLn(OT,dlGetNext(dL0, S1):6, S1:7);
  263.     end;
  264.   AnyKey;
  265.  
  266.   WriteLn(OT);
  267.   WriteLn(OT,'GetNext check, using dL1. [7..1]');
  268.   WriteLn(OT,dlGetFirst(dL1, S1):6, S1:7);
  269.   for T2 := 2 to 2*dL1.Count do begin
  270.     WriteLn(OT,dlGetNext(dL1, S1):6, S1:7);
  271.     end;
  272.   AnyKey;
  273.  
  274.   WriteLn(OT);
  275.   WriteLn(OT,'GetNext check, using dL1. [7..1]');
  276.   WriteLn(OT,dlGetFirst(dL1, S1):6, S1:7);
  277.   for T2 := 2 to 2*dL1.Count do begin
  278.     WriteLn(OT,dlGetNext(dL1, S1):6, S1:7);
  279.     end;
  280.   AnyKey;
  281.  
  282.   WriteLn(OT);
  283.   WriteLn(OT,'GetNext check, using dL2. [1..7]');
  284.   WriteLn(OT,dlGetFirst(dL2, S1):6, S1:7);
  285.   for T2 := 2 to 2*dL2.Count do begin
  286.     WriteLn(OT,dlGetNext(dL2, S1):6, S1:7);
  287.     end;
  288.   AnyKey;
  289.  
  290.   WriteLn(OT);
  291.   WriteLn(OT,'GetNext check, using dL3. [2..7, 1]');
  292.   WriteLn(OT,dlGetFirst(dL3, S1):6, S1:7);
  293.   for T2 := 2 to 2*dL3.Count do begin
  294.     WriteLn(OT,dlGetNext(dL3, S1):6, S1:7);
  295.     end;
  296.   AnyKey;
  297.  
  298.   WriteLn(OT);
  299.   WriteLn(OT,'GetNext check, using dL4. [1, 4, 6, 2, 5, 7, 3]');
  300.   WriteLn(OT,dlGetFirst(dL4, S1):6, S1:7);
  301.   for T2 := 2 to 2*dL4.Count do begin
  302.     WriteLn(OT,dlGetNext(dL4, S1):6, S1:7);
  303.     end;
  304.   AnyKey;
  305.  
  306.   WriteLn(OT);
  307.   WriteLn(OT,'Tail Check on dL0, dL1, dL2, dL3.');
  308.   WriteLn(OT,'dL0, ',(dL0.Tail^.Next = nil),
  309.         '     dL1, ',(dL1.Tail^.Next = nil),
  310.         '     dL2, ',(dL2.Tail^.Next = nil),
  311.         '     dL3, ',(dL3.Tail^.Next = nil));
  312.   AnyKey;
  313.  
  314.   WriteLn(OT);
  315.   WriteLn(OT,'Head Check on dL0, dL1, dL2, dL3.');
  316.   WriteLn(OT,'dL0, ',(dL0.Head^.Prev = nil),
  317.      '     dL1, ',(dL1.Head^.Prev = nil),
  318.      '     dL2, ',(dL2.Head^.Prev = nil),
  319.      '     dL3, ',(dL3.Head^.Prev = nil));
  320.   AnyKey;
  321.  
  322.   WriteLn(OT);
  323.   WriteLn(OT,'Read reverse using dL0, dL1, dL2, dL3.');
  324.   WriteLn(OT,'   Read from tail to head, ''Bomb Out'', Read from tail.');
  325.   if dlGetLast(dL0, S1) then Write(OT, S1:7) else dlBombOut;
  326.   if dlGetLast(dL1, S1) then Write(OT, S1:7) else dlBombOut;
  327.   if dlGetLast(dL2, S1) then Write(OT, S1:7) else dlBombOut;
  328.   if dlGetLast(dL3, S1) then WriteLn(OT,S1:7) else dlBombOut;
  329.   for T2 := 2 to 2*dL0.Count do begin
  330.     if dlGetPrev(dL0, S1) then Write(OT, S1:7) else dlBombOut;
  331.     if dlGetPrev(dL1, S1) then Write(OT, S1:7) else dlBombOut;
  332.     if dlGetPrev(dL2, S1) then Write(OT, S1:7) else dlBombOut;
  333.     if dlGetPrev(dL3, S1) then WriteLn(OT,S1:7) else dlBombOut;
  334.     end;
  335.   AnyKey;
  336.  
  337.   WriteLn(OT);
  338.   WriteLn(OT,'Pop test, using dL1.');
  339.   while dlPop(dL1, S1) do
  340.     WriteLn(OT,S1);
  341.   WriteLn(OT,'dL1 ', dlCount(dL1):3, dlSpaceUsed(dL1):3);
  342.   AnyKey;
  343.  
  344.   WriteLn(OT);
  345.   WriteLn(OT,'Pop test, using dL4.');
  346.   while dlPop(dL4, S1) do
  347.     WriteLn(OT,S1);
  348.   WriteLn(OT,'dL4 ', dlCount(dL4):3, dlSpaceUsed(dL4):3);
  349.   AnyKey;
  350.  
  351.   WriteLn(OT);
  352.   WriteLn(OT,'Free test, using dL0, dL2, dL3, dL4.');
  353.   dlFree(dL0); dlFree(dL2); dlFree(dL3); dlFree(dL3);
  354.   WriteLn(OT,'dL0 ', dlCount(dL0):3, dlSpaceUsed(dL0):3);
  355.   WriteLn(OT,'dL2 ', dlCount(dL2):3, dlSpaceUsed(dL2):3);
  356.   WriteLn(OT,'dL3 ', dlCount(dL3):3, dlSpaceUsed(dL3):3);
  357.   WriteLn(OT,'dL4 ', dlCount(dL4):3, dlSpaceUsed(dL4):3);
  358.   WriteLn(OT,MemAvail);
  359.  
  360.   Close(OT);
  361.   end; {ListTest}
  362. end.
  363.